home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stTrace.c < prev    next >
C/C++ Source or Header  |  1995-10-17  |  12KB  |  429 lines
  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stTrace.c    1.3    95/10/17")
  13.  
  14.  
  15. /****************************************************************/
  16. /*
  17.  * This is the 'main' tracing routine for the object.  It allows
  18.  * access to the whole object, and also handles references to
  19.  * pieces of the object (which are themselves objects).
  20.  */
  21. static CONST char *struct_last_trace_error;
  22. char *
  23. Struct_MainTraceProc(cdata, interp,name1,name2,flags)
  24.   ClientData cdata;
  25.   Tcl_Interp *interp;
  26.   char *name1,*name2;
  27.   int flags;
  28. {
  29.     Struct_Object *object = (Struct_Object *)cdata;
  30.     Struct_Object thisobj;
  31.     CONST char *errstr;
  32.  
  33.     if (object == NULL) {
  34.     return "Null pointer for object data in trace!";
  35.     }
  36. #ifdef DEBUG
  37.     if (struct_debug & (DBG_PARSEELEMENT)) {
  38.      printf("Struct_MainTraceProc( %s(%s), f = %03o )\n",
  39.     name1,name2 ? name2 : "<null>",flags);
  40.      printf("\tdata=%p, type=%s, size=%d\n",
  41.     object->data,
  42.     Struct_TypeName(object->type),
  43.     object->size );
  44.     }
  45. #endif
  46.     /*  If the whole object is being deleted, then de-allocate
  47.      *  the object and return.
  48.      */
  49.     if (flags & TCL_TRACE_DESTROYED) {
  50.     Struct_DeleteObject(object);
  51.     return NULL;
  52.     }
  53.  
  54.     /*  The first thing to do is figure out what 'name2'
  55.      *  (if present) points to.  This 'thing' will also be
  56.      *  an object.
  57.      */
  58.     thisobj = *object;
  59.     Struct_AttachType(thisobj.type);
  60.     if ((errstr = Struct_AccessElement( interp, &thisobj, name2 )) != NULL) {
  61.     Struct_ReleaseType(thisobj.type);
  62.     return (char *)errstr;
  63.     }
  64.  
  65.     /*  Now call the correct tracing routine for the piece
  66.      *  of the object.
  67.      */
  68. #ifdef TCL_MEM_DEBUG
  69.     Tcl_ValidateAllMemory(__FILE__,__LINE__);
  70. #endif
  71.     if (thisobj.type->TraceProc == NULL) {
  72. #ifdef DEBUG
  73.     if (struct_debug & (DBG_PARSEELEMENT))
  74.     printf("\tdata=%p, type=%s, size=%d\n",
  75.         object->data,
  76.         Struct_TypeName(object->type),
  77.         object->size );
  78. #endif
  79.     Struct_ReleaseType(thisobj.type);
  80.     return "NULL TraceProc for object!";
  81.     }
  82.     {
  83.       ClientData cdata;
  84.       if ((cdata = Struct_GetClientData(interp)) != NULL) {
  85.     if (flags & TCL_TRACE_READS)
  86.         Struct_PkgInfo(cdata,si_rdCount) += 1;
  87.     else if (flags & TCL_TRACE_WRITES)
  88.         Struct_PkgInfo(cdata,si_wrCount) += 1;
  89.       }
  90.     }
  91.     errstr = (*thisobj.type->TraceProc)(&thisobj,interp,name1,name2,flags);
  92.     if (errstr != NULL)
  93.     struct_last_trace_error = errstr;    /* save for TraceStruct, et. al. */
  94.     Struct_ReleaseType(thisobj.type);
  95. #ifdef TCL_MEM_DEBUG
  96.     Tcl_ValidateAllMemory(__FILE__,__LINE__);
  97. #endif
  98.  
  99.     return (char *)errstr;    /* Either NULL(good) or an error string */
  100. }
  101.  
  102.  
  103. /* I/O Pointer Trace */
  104. char *
  105. Struct_TracePtr(cdata, interp,name1,name2,flags)
  106.   ClientData cdata;
  107.   Tcl_Interp *interp;
  108.   char *name1,*name2;
  109.   int flags;
  110. {
  111.   Struct_Object *object = (Struct_Object *)cdata;
  112.   static char ptrbuf[80];
  113.  
  114.   if (!(object->type->flags & STRUCT_FLAG_IS_POINTER))
  115.     return "non-pointer type in Struct_TracePtr";
  116.   
  117.   if (flags & TCL_TRACE_READS) {
  118.     int v;
  119.     /* Read a ptr : */
  120.     memcpy(&v,object->data,sizeof(v));  /* avoid bus error for misalignment */
  121.     if (object->type->u.a.array_elem->name == NULL)
  122.         sprintf(ptrbuf,"%d",v);
  123.     else if (v == 0)
  124.     strcpy(ptrbuf,"0");
  125.     else
  126.         sprintf(ptrbuf,"%.64s#%d",object->type->u.a.array_elem->name, v );
  127.     Tcl_SetVar2(interp,name1,name2,ptrbuf,flags&TCL_GLOBAL_ONLY);
  128.   } else if (flags & TCL_TRACE_WRITES) {
  129.     char *v;
  130.     char *s;
  131.     Struct_Object objbuf;
  132.     /* Write a ptr : illegal, make it read-only : */
  133.     if (object->type->u.a.array_elem->name == NULL)
  134.         return "can't change anonymous pointers";
  135.     if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  136.     return "null ptr in ptr write";
  137.     if (strcmp(s,"0") == 0) {
  138.     v = NULL;
  139.     memcpy(object->data,&v,sizeof(v));    /* avoid bus error for misalignment */
  140.     return NULL;
  141.     }
  142.     if (Struct_GetObject(interp,s,&objbuf) == TCL_ERROR)
  143.     return "not a valid object or pointer";
  144.     v = (char *)objbuf.data;
  145.     if (objbuf.type != object->type->u.a.array_elem) {
  146.     Struct_ReleaseType(objbuf.type);
  147.     return "type mismatch in pointer write(o)";
  148.     }
  149.     Struct_ReleaseType(objbuf.type);
  150.     memcpy(object->data,&v,sizeof(v));    /* avoid bus error for misalignment */
  151.     return NULL;
  152.   } else {
  153.     /* Unset : */
  154. #ifdef DEBUG
  155.     printf("\tunset!\n");
  156. #endif
  157.     Struct_DeleteObject(object);
  158.   }
  159.   return NULL;    
  160. }
  161.  
  162. /* I/O Address Trace */
  163. char *
  164. Struct_TraceAddr(cdata, interp,name1,name2,flags)
  165.   ClientData cdata;
  166.   Tcl_Interp *interp;
  167.   char *name1,*name2;
  168.   int flags;
  169. {
  170.   Struct_Object *object = (Struct_Object *)cdata;
  171.   static char ptrbuf[80];
  172.  
  173.   if (!(object->type->flags & STRUCT_FLAG_IS_ADDR))
  174.     return "non-address type in Struct_TraceAddr";
  175.   
  176.   if (flags & TCL_TRACE_READS) {
  177.     /* Read the data's address (in the form of a pointer) */
  178.     if (object->data == NULL)
  179.     strcpy(ptrbuf,"0");
  180.     else if (object->type->u.a.array_elem->name == NULL)
  181.         sprintf(ptrbuf,"%ld", (long)object->data);
  182.     else
  183.         sprintf(ptrbuf,"%.64s#%ld",object->type->u.a.array_elem->name,
  184.         (long)object->data );
  185.     Tcl_SetVar2(interp,name1,name2,ptrbuf,flags&TCL_GLOBAL_ONLY);
  186.   } else if (flags & TCL_TRACE_WRITES) {
  187.     /* Change the address of data: illegal, make it read-only : */
  188.     return "cannot change an object's address";
  189.   } else {
  190.     /* Unset : */
  191. #ifdef DEBUG
  192.     printf("\tunset!\n");
  193. #endif
  194.     Struct_DeleteObject(object);
  195.   }
  196.   return NULL;    
  197. }
  198.  
  199.  
  200. /*    I/O Structure Trace
  201.  * Convert to a list of files in the structure.
  202.  */
  203. char *
  204. Struct_TraceStruct(cdata, interp,name1,name2,flags)
  205.   ClientData cdata;
  206.   Tcl_Interp *interp;
  207.   char *name1,*name2;
  208.   int flags;
  209. {
  210.     Struct_Object *object = (Struct_Object *)cdata;
  211.     char namebuf[256];
  212.     char *p;
  213.     char *s;
  214.     Struct_StructElem *pelem;
  215.  
  216.     if (!(object->type->flags & STRUCT_FLAG_IS_STRUCT))
  217.     return "non-struct type in Struct_TraceStruct";
  218.   
  219. #ifdef DEBUG
  220.     if (struct_debug & (DBG_PARSEELEMENT)) {
  221.       printf("Struct_TraceStruct( %s(%s), f = %03o )\n",
  222.     name1,name2 ? name2 : "",flags);
  223.       printf("\tdata=%p, type=%s, size=%d\n",
  224.     object->data,
  225.     Struct_TypeName(object->type),
  226.     object->size );
  227.     }
  228. #endif
  229.  
  230.     /*  Get the name buffer ready for accessing the individual
  231.      *  of the structure.
  232.      */
  233.     if (name2 == NULL || *name2 == '\0') {
  234.     namebuf[0] = '\0';
  235.     p = namebuf;
  236.     } else {
  237.     strcpy( namebuf, name2 );
  238.     p = strchr( namebuf, '\0' );
  239.     *p++ = '.';
  240.     }
  241.  
  242.     if (flags & TCL_TRACE_READS) {
  243.     Tcl_DString result;
  244.     Tcl_DStringInit(&result);
  245.     /* Tcl_DStringStartSublist(&result); */
  246.     for ( pelem = object->type->u.s.struct_def; pelem->type != NULL; pelem++ ) {
  247.         /* Build the proper name. */
  248.         strcpy( p, pelem->name );
  249. #ifdef FOR_INFO_ONLY
  250.         objbuf.data = (char *)object->data + pelem->offset;
  251.         objbuf.type = pelem->type;
  252.         objbuf.size = pelem->type->size;
  253. #endif
  254.  
  255.         /* Now read the value ourselves. */
  256.         s = Tcl_GetVar2(interp,name1,namebuf,flags&TCL_GLOBAL_ONLY);
  257.         if (s == NULL) {
  258.         static Tcl_DString errbuf;
  259. bad_element:
  260.         Tcl_DStringFree(&errbuf);
  261.         Tcl_DStringAppend(&errbuf,"structure element \"",-1);
  262.         Tcl_DStringAppend(&errbuf,namebuf,-1);
  263.         Tcl_DStringAppend(&errbuf,"\": ",-1);
  264.         Tcl_DStringAppend(&errbuf,(char *)struct_last_trace_error,-1);
  265.         return Tcl_DStringValue(&errbuf);
  266.         }
  267.         Tcl_DStringAppendElement(&result,s);
  268.     }
  269.     /* Tcl_DStringEndSublist(&result); */
  270.     Tcl_SetVar2(interp,name1,name2,Tcl_DStringValue(&result),flags&TCL_GLOBAL_ONLY);
  271.     Tcl_DStringFree(&result);
  272.     } else if (flags & TCL_TRACE_WRITES) {
  273.     /* Write a structure: */
  274.     int argc;
  275.     char **argv;
  276.     int i;
  277.     if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  278.         return "null ptr in struct write";
  279. #ifdef DEBUG
  280.     if (struct_debug & (DBG_ARRAY))
  281.     printf("Struct_TraceStruct: Write struct %s with {%s}\n",
  282.         Struct_TypeName(object->type), s );
  283. #endif
  284.     if (Tcl_SplitList(interp,s,&argc,&argv) == TCL_ERROR)
  285.         return NULL;
  286.  
  287.     if (argc > object->type->u.s.num_elements)
  288.         return "too many fields for structure";
  289.  
  290.     for ( i = 0, pelem = object->type->u.s.struct_def; i < argc; i++, pelem++ ) {
  291.         /* Build the proper name. */
  292.         strcpy( p, pelem->name );
  293. #ifdef FOR_INFO_ONLY
  294.         objbuf.data = (char *)object->data + pelem->offset;
  295.         objbuf.type = pelem->type;
  296.         objbuf.size = pelem->type->size;
  297. #endif
  298.  
  299.         /* Now set the the individual value. */
  300.         s = Tcl_SetVar2(interp,name1,namebuf,argv[i],flags&TCL_GLOBAL_ONLY);
  301.         if (s == NULL)
  302.         goto bad_element;
  303.     }
  304.  
  305.     ckfree((char *)argv);
  306.     } else {
  307.     /* Unset : */
  308. #ifdef DEBUG
  309.     printf("\tunset!\n");
  310. #endif
  311.     Struct_DeleteObject(object);
  312.     }
  313.     return NULL;    
  314. }
  315.  
  316. /*    I/O Array Trace
  317.  * This trace routine converts arrays too and from lists of elements.
  318.  *
  319.  * Note: Character and Hex arrays are traced by the TraceChar and TraceHex routines
  320.  */
  321. char *
  322. Struct_TraceArray(cdata, interp,name1,name2,flags)
  323.   ClientData cdata;
  324.   Tcl_Interp *interp;
  325.   char *name1,*name2;
  326.   int flags;
  327. {
  328.     Struct_Object *object = (Struct_Object *)cdata;
  329.     char namebuf[256];
  330.     char *p;
  331.     char *s;
  332.  
  333.     if (!(object->type->flags & STRUCT_FLAG_IS_ARRAY))
  334.     return "non-array type in Struct_TraceArray";
  335.   
  336. #ifdef DEBUG
  337.     if (struct_debug & (DBG_PARSEELEMENT)) {
  338.       printf("Struct_TraceStruct( %s(%s), f = %03o )\n",
  339.     name1,name2 ? name2 : "",flags);
  340.       printf("\tdata=%p, type=%s, size=%d\n",
  341.     object->data,
  342.     Struct_TypeName(object->type),
  343.     object->size );
  344.     }
  345. #endif
  346.  
  347.     /*  Get the name buffer ready for accessing the individual
  348.      *  items of the array.
  349.      */
  350.     if (name2 == NULL || *name2 == '\0') {
  351.     namebuf[0] = '\0';
  352.     p = namebuf;
  353.     } else {
  354.     strcpy( namebuf, name2 );
  355.     p = strchr( namebuf, '\0' );
  356.     *p++ = '.';
  357.     }
  358.  
  359.     if (flags & TCL_TRACE_READS) {
  360.     int i, nelem;
  361.     Tcl_DString result;
  362.     Tcl_DStringInit(&result);
  363.     /* Tcl_DStringStartSublist(&result); */
  364.     nelem = object->size / object->type->u.a.array_elem->size;
  365.     for ( i = 0; i < nelem; i++ ) {
  366.         /* Build the proper name. */
  367.         sprintf( p, "%d", i );
  368.  
  369.         /* Now read the value ourselves. */
  370.         s = Tcl_GetVar2(interp,name1,namebuf,flags&TCL_GLOBAL_ONLY);
  371.         if (s == NULL) {
  372.         static Tcl_DString errbuf;
  373. bad_element:
  374.         Tcl_DStringFree(&errbuf);
  375.         Tcl_DStringAppend(&errbuf,"array element \"",-1);
  376.         Tcl_DStringAppend(&errbuf,namebuf,-1);
  377.         Tcl_DStringAppend(&errbuf,"\": ",-1);
  378.         Tcl_DStringAppend(&errbuf,(char *)struct_last_trace_error,-1);
  379.         return Tcl_DStringValue(&errbuf);
  380.         }
  381.         Tcl_DStringAppendElement(&result,s);
  382.     }
  383.     /* Tcl_DStringEndSublist(&result); */
  384.     Tcl_SetVar2(interp,name1,name2,Tcl_DStringValue(&result),flags&TCL_GLOBAL_ONLY);
  385.     Tcl_DStringFree(&result);
  386.     } else if (flags & TCL_TRACE_WRITES) {
  387.     /* Write a structure: */
  388.     int argc;
  389.     char **argv;
  390.     int i;
  391.     int nelem;
  392.     if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  393.         return "null ptr in struct write";
  394. #ifdef DEBUG
  395.     if (struct_debug & (DBG_ARRAY))
  396.     printf("Struct_TraceArray: Write array %s with {%s}\n",
  397.         Struct_TypeName(object->type), s );
  398. #endif
  399.     if (Tcl_SplitList(interp,s,&argc,&argv) == TCL_ERROR)
  400.         return NULL;
  401.  
  402.     nelem = object->size / object->type->u.a.array_elem->size;
  403.     if (argc > nelem)
  404.         return "too many items for array";
  405.     else if ( (argc < nelem ) &&
  406.               (object->type->flags & STRUCT_FLAG_STRICT) )
  407.         return "too few items for array";
  408.  
  409.     for ( i = 0; i < argc; i++ ) {
  410.         /* Build the proper name. */
  411.         sprintf( p, "%d", i );
  412.  
  413.         /* Now set the the individual value. */
  414.         s = Tcl_SetVar2(interp,name1,namebuf,argv[i],flags&TCL_GLOBAL_ONLY);
  415.         if (s == NULL)
  416.         goto bad_element;
  417.     }
  418.  
  419.     ckfree((char *)argv);
  420.     } else {
  421.     /* Unset : */
  422. #ifdef DEBUG
  423.     printf("\tunset!\n");
  424. #endif
  425.     Struct_DeleteObject(object);
  426.     }
  427.     return NULL;    
  428. }
  429.